home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / runtime / equal.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-24  |  1.1 KB  |  50 lines  |  [TEXT/MPS ]
  1. #include "fail.h"
  2. #include "memory.h"
  3. #include "misc.h"
  4. #include "mlvalues.h"
  5. #include "str.h"
  6.  
  7. /* Structural equality on trees.
  8.    Loops on cyclic structures. */
  9.  
  10. static int tree_equal_aux(v1, v2)
  11.      value v1,v2;
  12. {
  13.   mlsize_t i;
  14.   value * p1, * p2;
  15.  
  16.  again:
  17.   if (v1 == v2) return 1;
  18.   if (Is_long(v1) || Is_long(v2)) return 0;
  19.   if (!Is_in_heap(v1) && !Is_young(v1)) return 0;
  20.   if (!Is_in_heap(v2) && !Is_young(v2)) return 0;
  21.   if (Tag_val(v1) != Tag_val(v2)) return 0;
  22.   switch(Tag_val(v1)) {
  23.   case String_tag:
  24.     return (compare_strings(v1, v2) == Val_long(0));
  25.   case Double_tag:
  26.     return (Double_val(v1) == Double_val(v2));
  27.   case Abstract_tag:
  28.   case Final_tag:
  29.     return 0;
  30.   case Closure_tag:
  31.     invalid_argument("equal: functional value");
  32.   default:
  33.     i = Wosize_val(v1);
  34.     if (i != Wosize_val(v2)) return 0;
  35.     for(p1 = Op_val(v1), p2 = Op_val(v2);
  36.         i > 1;
  37.         i--, p1++, p2++)
  38.       if (!tree_equal_aux(*p1, *p2)) return 0;
  39.     v1 = *p1;
  40.     v2 = *p2;                   /* Tail-call */
  41.     goto again;
  42.   }
  43. }
  44.  
  45. value tree_equal(v1, v2) /* ML */
  46.      value v1, v2;
  47. {
  48.   return Atom(tree_equal_aux(v1,v2));
  49. }
  50.